perm filename SAVE[RST,LCS] blob
sn#249592 filedate 1976-10-30 generic text, type T, neo UTF8
00100 COMMENT ā VALID 00002 PAGES
00200 C REC PAGE DESCRIPTION
00300 C00001 00001
00400 C00002 00002 C**** VARIOUS SUBROUTINES FOR PAGE LAYOUT PROGRAM. ****
00500 C00014 ENDMK
00600 Cā;
00100 C**** VARIOUS SUBROUTINES FOR PAGE LAYOUT PROGRAM. ****
00200
00300 SUBROUTINE FILOUT(NAMQ,NPG)
00400 COMMON /FIN/JBAR,NPX,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
00500 1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2
00600 1 /SF/KL,RT,KP,STFSZ,NAMX
00700 CC MTR1=-1
00800 CC MTR2=-1
00900 NAMQ='AAAAA'
01000 103 FORMAT(' TYPE OUTPUT FILE NAME ',$)
01100 102 FORMAT(A5)
01200 TYPE 103
01300 ACCEPT 102,NAMX
01400 IF(NAMX.EQ.' ')NAMX=NAMQ
01500 NAMZ=NAMX
01600 NPG=1
01700 IF(LOOKF(NAMX).GE.0)GO TO 88
01800 TYPE 88,NAMX
01900 ACCEPT 102,L
02000 IF(L.EQ.'N')GO TO 103
02100 88 FORMAT(' WRITE OVER FILE ',A5,'???? '$)
02200 END
02300
02400 CC SUBROUTINE METER(MTR,R)
02500 CC COMMON /FIN/JBAR,NPX,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
02600 CC 1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2
02700 CC 1/IPG/IPG,JPG,BRACK,RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(-3/4)
02800 CC 1 /SF/KL,RT,KP,STFSZ,NAMX
02900 CC K=MTR/100
03000 CC B=MTR-K*100
03100 CC A=K
03200 CC J=LPG
03300 CC1 RT=RSTNUM(J)
03400 C RT (IN COMMON) TRANSFERS THE STAFF NUM. TO SUBR. STAFF
03500 C PUT METER ON ALL STAVES FOR PAGE LAYOUT
03600 CC CALL STAFF(4.,18.,R,0,A,B,0,0)
03700 C PUTS IN METER AT START OF STAFF
03800 CC J=J-1
03900 CC IF(J.GT.0)GO TO 1
04000 CC MTR=-1
04100 CC END
04200
04300
04400 SUBROUTINE FILEIN
04500 COMMON /FIN/JBAR,NPX,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
04600 1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2
04700 1/IPG/IPG,JPG,BRACK,RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(-3/4)
04800 1 /RSP/KNM(10),ENDLN,N,NAME,NMPG,T /KBAR/KBAR(512)
04900 COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
05000 COMMON /POSI/STFF(-3/4),JJ2,JPQ /LLL/L,LL,I,RXQ
05100 COMMON/STF/RSTFAC(-3/4),RSTJ2 /PX/KPN(1) /Q/Q(1)
05200 1 /NBAR/NBAR(36) /SIZE/SIZE
05300 EQUIVALENCE (LASTNM,KBAR(3))
05400
05500 IF(NBAR(LC).EQ.0)CALL EXIT
05600 IF(KPX.EQ.1)GO TO 104
05700 C SKIP THIS FIRST TIME. IT SHUFFLES DATA FORWARD IN ARRAY.
05800 J=KPX-1
05900 JJ=KPN(KPX)-1
06000 DO 105 K=1,NPX-J
06100 105 KPN(K)=KPN(K+J)-JJ
06200 J=KPN(NPX)-JJ
06300 C HOW MUCH TO SHIFT THE Q ARRAY
06400 DO 106 K=1,J
06500 106 Q(K)=Q(K+JJ)
06600 KPX =NPX-KPX+1
06700 C UPDATE POINTERS FOR NEXT READIN
06800 KQ=KPN(KPX)
06900 JPX=KQ-1
07000
07100 104 KL=1
07200 KP=1
07300 JEND=0
07400 C FLAG FOR PAGE END - WHEN -1
07500 CC RT=2
07600 CC J=KK
07700 CC HGT=HX*2.
07800 CC LD=0
07900 CC MTR1=-1
08000 CC K=KK-1
08100 IF(LB.LT.NBAR(LC))GO TO 220
08200 NPX=KPX
08300 KPX=1
08400 LB=0
08500 GO TO 241
08600 220 CALL GETFIL(NMPG)
08700 CALL FASTIN(RSTFAC,22)
08800 211 CALL FASTIN(KPN(KPX),JJ2)
08900 CALL FASTIN(Q(KQ),JPQ)
09000 IF(KPX.EQ.1)GO TO 140
09100 B=0
09200 JJ=JJ2+KPX-1
09300 DO 420 JP=KPX,JJ
09400 K=KPN(JP)+JPX
09500 KPN(JP)=K
09600 R=Q(K+1)
09700 IF(B.NE.0)GO TO 420
09800 IF(R.GT.2)GO TO 420
09900 B=Q(K+3)
10000 C B=POS OF FIRST NOTE OR REST IN NEW FILE.
10100 DO 1 KK=KPX,JP
10200 LA=KPN(KK)
10300 R=Q(LA+1)
10400 IF(R.NE.44)GO TO 7
10500 IF(Q(LA+5).EQ.0.OR.Q(LA+6).EQ.0.OR.Q(LA).LT.4)GO TO 1
10600 C LOOK AT LINES, CRESC, DASHES, WIGGLES ONLY.
10700 GO TO 2
10800 7 IF(R.NE.7)GO TO 5
10900 IF(Q(LA).LT.5)GO TO 1
11000 RR=ABS(Q(LA+7))
11100 IF(RR.GT.1.AND.RR.LT.8)GO TO 1
11200 C AVOID PEDAL MARKS.
11300 GO TO 2
11400 5 IF(R.NE.5)GO TO 1
11500 C FOUND SLUR INTO LEFT SIDE OF LINE
11600 A=Q(LA+6)
11700 C=Q(LA+2)
11800 2 DO 3 NN=1,KPX-1
11900 II=KPN(NN)
12000 RR=Q(II+1)
12100 IF(RR.NE.R)GO TO 3
12200 IF(Q(II).LT.4)GO TO 3
12300 IF(Q(II+2).NE.C)GO TO 3
12400 C CATCHES ONLY ONE SLUR(ETC.) POS PER STAFF!!
12500 IF(Q(II+6).LT.D)GO TO 3
12600 Q(II+6)=A
12700 C ADJUSTS PARAM 6 TO POSITION IN NEW FILE.
12800 GO TO 1
12900 3 CONTINUE
13000 1 CONTINUE
13100 420 CONTINUE
13200 140 JPX=KQ+JPQ-3
13300 C NUM OF WORDS TO SHIFT.
13400 41 NMPG=NMPG+2
13500 C NMPG = NAME OF INPUT FILES
13600 CC L=JJ2-2
13700 CC NPX=KPX+L
13800 NPX=KPX+JJ2-2
13900 241 JBAR=NBAR(LC)
14000 DO 20 JP=KPX,NPX-1
14100 N=KPN(JP)
14200 IF(Q(N+1).NE.4)GO TO 20
14300 C FINDS BAR LINES IN THIS PART OF DATA
14400 LB=LB+1
14500 IF(LB.NE.JBAR)GO TO 20
14600 KPX=JP+1
14700 D=Q(N+3)
14800 C SAVE POS OF LAST BAR FOR SLUR CONNECTIONS, ETC.
14900 520 IF(Q(KPN(KPX)+1).NE.18)GO TO 20
15000 C LOOKS FOR METER BEYOND LAST BAR IN LINE
15100 IF(KPX.GE.NPX)GO TO 20
15200 KPX=KPX+1
15300 GO TO 520
15400 20 CONTINUE
15500 IF(LB.GE.JBAR)GO TO 120
15600 KPX=NPX
15700 KQ=JPX+1
15800 GO TO 220
15900 120 KQ=KPN(KPX)
16000 LB=LB-JBAR
16100 L=KPX-1
16200 C L=TOTAL ITEMS FOR THIS LINE. JBAR=TOTAL BARS, LB=HOW MANY LEFT OVER
16300 I=L
16400 IF(LB.NE.0)RETURN
16500 KPX=1
16600 KQ=1
16700 END
16800
16900 SUBROUTINE STAVES
17000 DATA SLSP/12.0/
17100 COMMON /FIN/JBAR,NPX,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
17200 1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2
17300 COMMON /SF/KL,RT,KP,STFSZ,NAMX /IPG/IPG,JPG,BRACK,
17400 1 RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(-3/4)
17500 1 /RSP/KNM(10),ENDLN,N,NAME,NMPG,T /KBAR/KBAR(512)
17600 COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
17700 COMMON/STF/RSTFAC(-3/4),RSTJ2 /IVV/OSLUR(1)
17800 COMMON /POSI/STFF(-3/4),JJ2,JPQ /LLL/L,LL,I,RXQ
17900 1/PX/KPN(1) /Q/Q(1) /PTR/KWDS(1) /XRN/RN(1) /NBAR/NBAR(36)
18000 DIMENSION ENDSTF(450),KPTR(50)
18100 C ENDSTF AND ENDPTR FOR CARRYING STUFF FROM ONE LINE TO THE NEXT.
18200 EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
18300 1,(ENDSTF,KBAR(4)),(KPTR,KBAR(460)),(KEND,KBAR)
18400 1,(R8,RQ(6)),(R9,RQ(7))
18500 IF(LC.EQ.1)RA=0
18600 C RA IS LEFT POS OF Q DATA. (IT SHIFTS AS LC CHANGES.)
18700 KL=1
18800 KP=1
18900 LC=LC+1
19000 335 RX=0
19100 IF(NBAR(LC).EQ.0)JEND=-1
19200 3 JJ=KP
19300
19400 C ******** PUTS IN STAFF ********
19500 RS=3.
19600 C RS IS WDCNT FOR SUBR. STAFF
19700 IF(RT.EQ.0)RS=6
19800 C =6 FOR BOTTOM STAFF. PUTS IN SPACER.
19900 CC331 IF(IPG)GO TO 411
20000 HX=8
20100 RZ=0
20200 RX=RT
20300 DO 611 JP=1,LPG
20400 RT=RSTNUM(JP)
20500 RS=3
20600 C WD CNT IS RS, HX IS CODE(8), ARRAYS AND LPG(JPG) WERE SET UP IN MAIN.
20700 RR=0
20800 IF(NAMX.EQ.NAMZ)GO TO 611
20900 IF(RT.NE.0)GO TO 611
21000 RS=6
21100 RR=SPG
21200 C FOR SPACER ON STAFF 0
21300 611 CALL STAFF(RS,HX,RZ,RHGT(JP),RPSZ(JP),RZ,RZ,RR)
21400 HX=LPG
21500 RS=4.
21600 RT=0
21700 CALL STAFF(2.,RS,RZ,HX,RZ,RZ,RZ,RZ)
21800 IF(BRACK.NE.0)CALL STAFF(5.,RS,RZ,HX,RZ,RZ,BRACK,RZ)
21900 RT=RX
22000 GO TO 511
22100 411 CALL STAFF(RS,8.,0,HGT,RSTJ2,0,0,SP)
22200 HGT=HGT-HX
22300 511 IF(JEND)GO TO 60
22400 C FOR PREMATURE PAGE END
22500 CP IF(K.NE.I)GO TO 6
22600 IF(RT.EQ.0)GO TO 6
22700 60 IF(IPG.EQ.0)GO TO 6
22800 RX=RT
22900 RT=0
23000 CALL STAFF(6.,8.,0,0,0,0,1.,SP)
23100 C PUTS IN SPACER
23200 RT=RX
23300
23400 C ****** NEXT FOR CLEFS ************
23500 6 IF(CLEF.EQ.-99)GO TO 33
23600 C ONLY STAFF FOR FIRST LINE AT TOP.
23700 RX=8.*RSTJ2
23800 C THE SPACER
23900 LA=0
24000 IF(IPG)GO TO 3011
24100 LA=LPG
24200 3111 RT=RSTNUM(LA)
24300 LL=RT
24400 CLEF=RCLEF(LL)
24500 C GETS CLEF FOR PAGE LAYOUT, RT IS STAFF# IN CALL
24600 LA=LA-1
24700 3011 CALL STAFF(3.,3.,1.5,0,CLEF,0,0,0)
24800 IF(SIG.EQ.-99)GO TO 3211
24900 C ***** NEXT FOR KEY SIG. ********
25000 RS=4.
25100 R5=SIG
25200 332 CALL STAFF(RS,17.,10.0*RSTJ2,0,R5,CLEF,0,0)
25300 3211 IF(LA.GT.0)GO TO 3111
25400 RX=11.*RSTJ2
25500 C RX SETS POS OF NEXT ITEM ON STAFF
25600 R7=RX
25700
25800 CZ33 IF(KEND.EQ.0)GO TO 31
25900 C JUMP IF NO CARRYOVERS FROM PREVIOUS LINE.
26000 33 LA=1
26100 CZ61 KK=KPTR(LA)
26200 CZ IF(KK.EQ.0)GO TO 31
26300 61 IF(ENDSTF(LA).EQ.0)GO TO 31
26400 RT=ENDSTF(LA+2)
26500 CALL STAFF(ENDSTF(LA),ENDSTF(LA+1),ENDSTF(LA+3),ENDSTF(LA+4),
26600 1 ENDSTF(LA+5),ENDSTF(LA+6),ENDSTF(LA+7),ENDSTF(LA+8))
26700 LA=LA+9
26800 CZ LA=LA+1
26900 GO TO 61
27000
27100 C RX SPACES NEXT ITEM TO RIGHT OF LINE BEGINNING.
27200 31 R4=RA
27300 LA=I
27400 231 K4=KPN(LA)
27500 R=Q(K4+1)
27600 IF(R.EQ.4)GO TO 131
27700 LA=LA-1
27800 GO TO 231
27900 131 RA=Q(K4+3)
28000 R5=RA
28100 DO 731 K=1,I
28200 KK=KPN(K)
28300 R=Q(KK+1)
28400 IF(R.EQ.44)GO TO 631
28500 IF(R.EQ.7)GO TO 631
28600 IF(R.NE.5)GO TO 731
28700 631 IF(Q(KK).LT.4)GO TO 731
28800 R=Q(KK+6)
28900 IF(R.LT.R5)GO TO 731
29000 Q(KK+6)=R5
29100 C CATCHES RIGHT SIDE OF THINGS FOR MOVER. (PEDS?)
29200 731 CONTINUE
29300 RS=0
29400 R7=RT
29500 R8=RX
29600 R9=200.
29700 LL=0
29800 L=I
29900 CALL PTMOVE(Q,KPN)
30000 IF(LA.EQ.I)RETURN
30100 C NEXT PUTS METER JUST BEYOND END OF LINE
30200 R=202
30300 R7=Q(KPN(LA+1)+3)
30400 C R7 HOLDS STAFF NUM. FOR THINGS BEYOND END OF LINE.
30500 DO 531 K5=LA+1,I
30600 K7=KPN(K5)
30700 K4=
30800 IF(Q(K7+1).EQ.18)K4=Q(K7+5)*100+Q(K7+6)
30900 C K4 STORES METER (TOP*100+BOTTOM)
31000 IF(Q(K7+3).EQ.R7)GO TO 531
31100 R7=Q(K7+3)
31200 C THIS PROBABLY WON'T ALWAYS DO THE RIGHT THING!!
31300 R=R+5
31400 CM IF(MTR1.GT.0.AND.K4.NE.0)MTR2=K4
31500 531 Q(K7+3)=R
31600 CM431 Q(K7+3)=R
31700 CM531 IF(K4.NE.0.AND.MTR1)MTR1=K4
31800 END
31900